perm filename QUADO.F4[MUS,LCS]1 blob
sn#007369 filedate 1974-01-08 generic text, type T, neo UTF8
00100 SUBROUTINE QUADO(P,IPAR,NL,XF,YF)
00200 DIMENSION P(30),FAC(4)
00300 EQUIVALENCE(XA,FAC(1)),(XB,FAC(2)),(XC,FAC(3)),(XD,FAC(4))
00400 XC=0
00500 XD=0
00600 IF(NL.EQ.-14.OR.NL.EQ.-16)GO TO 1
00700 C -14 OR -16=X,Y SYSTEM
00800 DG=AMOD(P(IPAR-4),360.0)
00900 C DG=DEGREES
01000 DX=DG
01100 IF(DX.GT.90.AND.DX.LE.180)DX=180.-DX
01200 C PUTS DX INTO UPPER QUADRANT
01300 IF(DX.GE.270.)DX=360.-DX
01400 IF(DX.GT.180.)DX=DX-180.
01500 DIS=P(IPAR-3)
01600 C DIST. FROM CENTER OF CIRCLE
01700 XX=P(IPAR-2)
01800 YY=P(IPAR-1)
01900 C XX,YY IS CENTER OF CIRCLE
02000 X=DIS*SIND(DX)
02100 Y=DIS*COSD(DX)
02400 IF(DG.GT.90.AND.DG.LT.270)Y=-Y
02500 C BOTTOM HALF
02600 IF(DG.GT.180)X=-X
02700 C LEFT HALF
02800 X=X+XX
02900 Y=Y+YY
02920 XF=X
02960 YF=Y
03000 GO TO 10
03100
03200 1 X=P(IPAR-4)
03300 Y=P(IPAR-3)
03400 XF=X
03500 YF=Y
03550 C XF AND YF SAVE COORDS FOR SHOWING PATH ON DPY.
03600 10 DIS=SQRT(X**2+Y**2)
03700 C DIST. OF SOUND FROM LISTENER
03750 IQUAD=1
03800 S=X
03900 T=Y
04000 XX=ABS(X)
04100 YY=ABS(Y)
04200 C NEXT FINDS QUADRANT
04300 IF(X.LT.YY)GO TO 7
04400 IQUAD=2
04500 S=-Y
04600 T=X
04700 GO TO 3
04800 7 IF(-Y.LT.XX)GO TO 8
04900 IQUAD=3
05000 S=-X
05100 T=-Y
05200 GO TO 3
05300 8 IF(-X.LE.YY)GO TO 3
05400 IQUAD=4
05500 S=Y
05600 T=-X
05700 3 XA=.5-S/(T*2)
05800 XB=1-XA
05900 C % OF SNUND IN EACH "FRONT" SPEAKER
06000 IF(DIS.GE.14.14)GO TO 30
06100 C OUTSIDE OF SPEAKER CIRCLE, THEN JUMP
06150 CC X=1-DIS/14.14
06200 X=(1-DIS/14.14)**2
06300 C FACTOR (OR TRY? (1-DIS/14.14)**2 )
06400 XA=XA+(1-XA)*X
06500 XB=XB+(1-XB)*X
06600 XC=XB*X
06700 XD=XA*X
06800 C SUM OF FACTORS WILL BE FROM 1(AT EDGE) TO 4(AT CENTER)
06900 GO TO 31
07000 30 X=1-((DIS-14.14)/DIS)**2
07100 C OUTSIDE CIRCLE (TRY ALSO SANS **)
07200 XA=XA*X
07300 XB=XB*X
07400 31 N=IPAR-5
07500 IQUAD=IQUAD-1
07600 DO 2 K=1,4
07700 J=IQUAD+K
07800 IF(J.GT.4)J=J-4
07900 2 P(J+N)=FAC(K)
08000 C SETS DIR. SIG. MULTIPLIERS FOR EACH SPKR
08100 P(IPAR)=0
08200 RETURN
08300 END
08400 C CAN BE USED FOR 2 CHANS. BUT 5 PARAMS STILL NEEDED.